#!/usr/bin/perl

=head1 NAME

filter.pl - Charles Mauch's Email Filter

=head1 DESCRIPTION

Replaces procmail, or at least my original procmail rules to perform the
following email filtering tasks:

=over 4

=item * Detect Mailing Lists automatically, sort them into hierarchial folders
similiar to ~/.mail/lists/org/debian/lists/politics, etc.  There should be zero
configuration to detect mailing lists.

=item * Store personal email into a different hierarchy based on the user's
surname, firstname, lastname, etc.  For example, the email folder would look
like ~/.mail/personal/b/becherer/andrew.  This makes it very easy to find
emails from particular people, and scales well for my email archives, which
include over 10 years, hundreds of people, and over 20,000 individual messages.

=item * Properly announce personal email messages, durning business hours of
course, with a jabber message or some other mechanism like festival.

=item * Properly scan for spam, and react appropriately.  Highly scored spam
should be rejected, logged, and reported automatically.  Spam with lower scores
is saved for manual review/reporting.  

=item * Updates your Little Brother Database by scraping emails for their email
addresses.  Very useful with MUA's like mutt which can use lbdb to query
external sources (such as a textfile, LDAP server, whatever).

=back

=head1 SYNOPSIS

in fetchmailrc, add something like this.

  mda "~/bin/perl/filter.pl"

can be tested with

  cat message.txt | ~/bin/perl/filter.pl


=head1 DEPENDENCIES

=head2 FROM CPAN

L<Email::Address>, L<Email::Filter>, L<Email::Filter::SpamAssassin>,
L<Time::Format>, L<Date::Manip>

=head2 LOCALLY

L<Email::Muckery>, L<Email::Deamons>, L<Email::Lists>, L<Email::Announce>,
L<Email::Bounce>, L<Email::Harvest>, L<Email::Logging>

=cut


# Load up Required Modules
use lib "/home/cpm/perl";                       # Set Manually

require configvars;                             # Every config variable needed
use Email::Muckery;                             # Folder Management
use Email::Deamons;                             # Filter Daemons out
use Email::Lists;                               # Check for List Email
use Email::Announce;                            # Announce Email in various ways
use Email::Bounce;                              # Bounce Email in various ways
use Email::Harvest;                             # Suck into LBDB
use Email::Logging;                             # Log into stat database
use Email::Address;                             # Detailed Address Handling
use Email::Filter::SpamAssassin;                # General Email Filtering
use Time::Format qw(%time %strftime %manip);    # General Date stuff
#use Mail::Message;                            
#use Email::Abstract;

=head1 GLOBAL VARIABLES

=over 4

=item * $now - current time
=item * $epochtime - current time in epoch seconds
=item * $item - Email::Filter reference
=item * $subject - obvious
=item * $sentdate - date email was sent (used for logging)
=item * @toarray, @ccarray, @fromarray, @delivarray - filled email addresses

=cut

$VERSION   = ( q$Revision: 87 $ ) =~ /(\d+)/g;
our $now = $manip{ '%m/%d/%Y %T' };
our $epochtime;
our $item = Email::Filter::SpamAssassin->new;
our $subject = $item->subject(); 
our $sentdate = $item->header( "Date" ); 
our @toarray    = Email::Address->parse( $item->to );
our @ccarray    = Email::Address->parse( $item->cc );
our @fromarray  = Email::Address->parse( $item->from );
our @delivarray = Email::Address->parse( $item->header( "Delivered-To" ) );

#use diagnostics;                               # We like very verbose errors
#use strict;                                    # Require $var scope declarations
#use warnings;                                  # Warn us too


chomp( $subject );                              # Fix up subject

if ( "$sentdate" ge "" ) {
    my $sentdate = $manip{ '%m/%d/%Y %T', $sentdate };
    $epochtime = $manip{ '%s', $sentdate };     # Time in Seconds from epoch
} else {
    $epochtime = $manip{ '%s' };                # Time in Seconds from epoch
}


# Get Spam Score via Mail::SpamAssassin! YAY!
my $spamstatus = $item->spam_check; # Perform spam check
my $score = $spamstatus->{'score'}; # Extract score

if ( $score > 4.9 ) {    # Begin Spam Loop
                         # For proper logging, lets extract spammers source 
    foreach my $spamaddr ( Email::Address->parse( $item->from ) ) {
        our $spammersemail = $spamaddr->address; 
        our $spammersname  = $spamaddr->name;
    }

    # Spam is evil, so log it, then nuke it
    Logger( $epochtime, $score, "spam", $main::spammersname, $main::spammersemail, $subject, "maybespam" );
    $item->accept( "$MauchConfig::maildir/spam/maybespam" );
} else {    # It's not spam!

    # Main Program Loop, its not spam!

    CheckLists();    # Perform a bunch of Mailing List tests since they're
                     # generally not addressed directly to us.

    foreach my $addr ( @toarray, @ccarray, @delivarray ) {    # Searches for To or CC address
        my $address = $addr->address;                         # Extracts email address for To or CC
        foreach my $match ( @MauchConfig::myemails ) {        # Compares To/CC to list of valid emails
            if ( $address eq $match ) {                       # For valid comparisons - continue
                my $username = $addr->name;                   # We have a valid To or CC, extract "my name"
                foreach my $addr ( @fromarray ) {             # Now lets dig out the From: Address
                    my $address  = $addr->address;            # Break it up, email and username
                    my $username = $addr->name;

                    if ( $MauchConfig::HarvestEMAIL eq "yes" ) { harvestemails( $address, $username ); }
                    CheckDaemons( $address, $username, $subject );    # Check for Daemon Messages and Bounces
                    #BounceCheck($address,$username,$subject);        # Check if we need to Bounce Email
                    #JabberAnnounce($address,$username,$subject);	  # Send Jabber Message of email
                    #FestivalAnnounce($username); 		              # Announce email with Festival

                    if ( $username eq $addr->user ) {    # If From = host portion of email
                        my $userfolder = getlistname( $address );    # Assign folder to stash based on email hiearchy
                        Logger( $epochtime, $score, "personal", $username, $address, $subject, "personal\/$userfolder/" );
                        $item->accept( "$MauchConfig::maildir/personal/$userfolder" );
                    } else {
                        my $userfolder = getfoldername( $username );    # Else assign by "Real Name"
                        Logger( $epochtime, $score, "personal", $username, $address, $subject, "personal\/$userfolder/" );
                        $item->accept( "$MauchConfig::maildir/personal/$userfolder" );
                    }
                } ## end foreach my $addr ( @fromarray)
            } ## end if ( $address eq $match)
        } ## end foreach my $match ( @MauchConfig::myemails)
    } ## end foreach my $addr ( @toarray...
} ## end else [ if ( $score > 4.9 )

# At this point, email ends up in problem folder.  Should have matched loop above.
$item->accept( "$MauchConfig::maildir/problem" );

=head1 BUGS AND LIMITATIONS

=over 4

=item * Fails to detect wierd email usernames, like Charles Warloe \(Volt\),
which is common for microsoft.com addresses. (sigh)
=item * Doesn't automatically deal with "really long names".
=item * Email usernames like J.T.S. Moore aren't sorted correctly

=back

=head1 TODO

=over 4

=item * Analyze User Agent, possibly respond to list messages with a report
(monthly) indicating who isn't using an opensource MUA.  Muahaha!  - Not even
sure I want to do this, but it's fun to think about.

=item * Deal with user+tag@domain.com style addresses, important for spam
avoidance.

=item * Integrate Ian Murdock's cabot.  Incoming pgp-signature requests would
be properly responded to.  I can probably just source most of his code.

=item * GTK notices perhaps?  Libnotify might provide this.

=item * MIME::Stuff - Everything below is waiting on figuring MIME Out

=item * Auto Verify PGP Signatures, Run sigtrace on them, attach results to
mime-encoded attachment to messages.  (Speeds up Mutt by preprocessing)

=item * Auto Verify S/MIME Signatures, attach results, store key in SSL dir.  -
Lot of work with MIME needs to be done before we can do this.

=item * AutoRespond to emails containing HTML, because we hate HTML!

=item * Bounce emails containing VBS (Virii) to sender.

=item * Bounce emails containing word/excel documents along with a nice rant

=back

=head1 AUTHOR

Charles Mauch <cmauch@gmail.com>

=head1 LICENSE

Copyright (c) 2006 Charles Mauch

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
Street, Fifth Floor, Boston, MA  02110-1301, USA.

=head1 SEE ALSO

perl(1).

=cut

# $Id: filter.pl 87 2006-10-10 09:59:58Z cmauch $
